home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / faq-s.zip / PULLDOWN.PAS < prev    next >
Pascal/Delphi Source File  |  1991-03-20  |  10KB  |  441 lines
  1. program pulldown;
  2.  
  3. uses dos, crt;
  4.  
  5. var c:char;
  6.     x,y,z,a:integer;
  7.     dir:string[127];
  8.  
  9. {$M 8192,0,0}
  10.  
  11. procedure cursor (csize : byte);
  12. var regs : registers;
  13. begin
  14.    case (csize) of
  15.       1 : if mem[0:$449] = 7 then regs.cx := $0c0d  { underline  = 1 }
  16.           else regs.cx := $0607;
  17.       2 : if mem[0:$449] = 7 then regs.cx := $060d  { full Block = 2 }
  18.           else regs.cx := $0007;
  19.       3 : regs.cx := $2000;                         { no Cursor  = 3 }
  20.    end;
  21.    regs.ax := $0100;
  22.    intr($10,regs);
  23. end;
  24.  
  25. procedure ahigh (x:integer);
  26. begin
  27.     case x of
  28.       1:begin
  29.             gotoxy (2,3);
  30.             textbackground (4);
  31.             textcolor (15);
  32.             write (' Root Directory ');
  33.             textbackground (15);
  34.             textcolor (4);
  35.         end;
  36.       2:begin
  37.             gotoxy (2,4);
  38.             textbackground (4);
  39.             textcolor (15);
  40.             write (' Other Dir      ');
  41.             textbackground (15);
  42.             textcolor (4);
  43.         end;
  44.     end;
  45. end;
  46.  
  47. procedure bhigh (x:integer);
  48. begin
  49.      case x of
  50.        1:begin
  51.              gotoxy (27,3);
  52.              textcolor (15);
  53.              textbackground (4);
  54.              write (' Copy   ');
  55.          end;
  56.        2:begin
  57.              gotoxy (27,4);
  58.              textcolor (15);
  59.              textbackground (4);
  60.              write (' Move   ');
  61.          end;
  62.        3:begin
  63.              gotoxy (27,5);
  64.              textcolor (15);
  65.              textbackground (4);
  66.              write (' Rename ');
  67.          end;
  68.        4:begin
  69.              gotoxy (27,6);
  70.              textcolor (15);
  71.              textbackground (4);
  72.              write (' Other  ');
  73.          end;
  74.      end;
  75. end;
  76.  
  77. procedure high (x:integer);
  78. begin
  79.      case x of
  80.       1:begin
  81.             gotoxy (2,1);
  82.             textbackground (4);
  83.             textcolor (15);
  84.             write (' ChDir ');
  85.         end;
  86.       2:begin
  87.             gotoxy (10,1);
  88.             textbackground (4);
  89.             textcolor (15);
  90.             write (' MkDir ');
  91.         end;
  92.       3:begin
  93.             gotoxy (18,1);
  94.             textbackground (4);
  95.             textcolor (15);
  96.             write (' RmDir ');
  97.         end;
  98.       4:begin
  99.             gotoxy (26,1);
  100.             textbackground (4);
  101.             textcolor (15);
  102.             write (' ExecCmd ');
  103.         end;
  104.       5:begin
  105.             gotoxy (36,1);
  106.             textbackground (4);
  107.             textcolor (15);
  108.             write (' Delete ');
  109.         end;
  110.       6:begin
  111.             gotoxy (45,1);
  112.             textbackground (4);
  113.             textcolor (15);
  114.             write (' Dir ');
  115.         end;
  116.       7:begin
  117.             gotoxy (51,1);
  118.             textbackground (4);
  119.             textcolor (15);
  120.             write (' Help ');
  121.         end;
  122.       8:begin
  123.             gotoxy (58,1);
  124.             textbackground (4);
  125.             textcolor (15);
  126.             write (' Quit ');
  127.         end;
  128.      end;
  129. end;
  130.  
  131. procedure dohelp;
  132. begin
  133.      gotoxy (50,10);
  134.      textbackground (3);
  135.      textcolor (14);
  136.      writeln ('╔══════════════════════╗');
  137.      gotoxy (50,11);
  138.      write ('║  ');
  139.      textcolor (15);
  140.      write (#27#26#25#24+' - Move Bar');
  141.      textcolor (14);
  142.      writeln ('     ║');
  143.      gotoxy (50,12);
  144.      write ('║ ');
  145.      textcolor (15);
  146.      write (' [Return] - Select');
  147.      textcolor (14);
  148.      writeln ('   ║');
  149.      gotoxy (50,13);
  150.      write ('║ ');
  151.      textcolor (15);
  152.      write (' ESC - Quits to Main ');
  153.      textcolor (14);
  154.      writeln ('║');
  155.      gotoxy (50,14);
  156.      writeln ('╚══════════════════════╝');
  157.      repeat
  158.      until keypressed;
  159. end;
  160.  
  161.  
  162. procedure changedir2;
  163. begin
  164.      gotoxy (6,10);
  165.      textbackground (4);
  166.      textcolor (15);
  167.      writeln ('╔═══ Enter Directory ══════════════╗');
  168.      gotoxy (6,11);
  169.      writeln ('║                                  ║');
  170.      gotoxy (6,12);
  171.      writeln ('╚══════════════════════════════════╝');
  172.      gotoxy (8,11);
  173.      textcolor (14);
  174.      cursor (2);
  175.      readln (dir);
  176.      if doserror <> 0 then begin
  177.        gotoxy (1,14);
  178.        textcolor (15);
  179.        textbackground (0);
  180.        cursor (3);
  181.        writeln ('Invalid Directory!');
  182.        exit;
  183.      end;
  184.      chdir (dir);
  185.      cursor (3);
  186.      textbackground (0);
  187.      gotoxy (6,10);
  188.      clreol;
  189.      gotoxy (6,11);
  190.      clreol;
  191.      gotoxy (6,12);
  192.      clreol;
  193. end;
  194.  
  195. procedure changedir;
  196. begin
  197.      textbackground (15);
  198.      textcolor (4);
  199.      ahigh (y);
  200.      gotoxy (1,2);
  201.      writeln ('╔════════════════╗');
  202.      writeln ('║ Root Directory ║');
  203.      writeln ('║ Other Dir...   ║');
  204.      writeln ('╚════════════════╝');
  205.      textbackground (15);
  206.      textcolor (4);
  207.      gotoxy (2,1);
  208.      ahigh (y);
  209.      repeat
  210.        c:=readkey;
  211.        c:=upcase (c);
  212.      until c in [#77,#75,#72,#80,#27,#13];
  213.      if (c=#77) or (c=#80) then y:=y+1;
  214.      if (c=#75) or (c=#72) then y:=y-1;
  215.      if y=3 then y:=1;
  216.      if y=0 then y:=2;
  217.      if c=#27 then exit;
  218.      if c=#13 then begin;
  219.        case y of
  220.         1:chdir('\');
  221.         2:changedir2;
  222.        end;
  223.      end;
  224.     changedir
  225. end;
  226.  
  227. procedure makedir;
  228. begin
  229.      gotoxy (6,10);
  230.      textbackground (4);
  231.      textcolor (15);
  232.      writeln ('╔═══ Enter Directory ══════════════╗');
  233.      gotoxy (6,11);
  234.      writeln ('║                                  ║');
  235.      gotoxy (6,12);
  236.      writeln ('╚══════════════════════════════════╝');
  237.      gotoxy (8,11);
  238.      textcolor (14);
  239.      cursor (2);
  240.      readln (dir);
  241.      if doserror <> 0 then begin
  242.       writeln ('Invalid Directory Name!');
  243.       cursor (3);
  244.       exit;
  245.      end;
  246.      mkdir (dir);
  247.      cursor (3);
  248.      textbackground (0);
  249.      gotoxy (6,10);
  250.      clreol;
  251.      gotoxy (6,11);
  252.      clreol;
  253.      gotoxy (6,12);
  254.      clreol;
  255. end;
  256.  
  257. procedure copyproc;
  258. var cf,ct:string;
  259. begin
  260.      gotoxy (1,8);
  261.      textcolor (14);
  262.      textbackground (1);
  263.      writeln ('╔══ Copy ═══════════════════════════════════════════╗');
  264.      writeln ('║                                                   ║');
  265.      writeln ('╚═══════════════════════════════════════════════════╝');
  266.      cursor (2);
  267.      gotoxy (3,9);
  268.      textcolor (15);
  269.      readln (cf);
  270.      if doserror <> 0 then begin
  271.        writeln ('Invalid Filename or File doesn''t Exist!');
  272.        exit;
  273.      end;
  274.      gotoxy (1,12);
  275.      textcolor (14);
  276.      writeln ('╔══ To ═════════════════════════════════════════════╗');
  277.      writeln ('║                                                   ║');
  278.      writeln ('╚═══════════════════════════════════════════════════╝');
  279.      gotoxy (3,13);
  280.      textcolor (15);
  281.      readln (ct);
  282.      if length(ct)=0 then begin
  283.        writeln ('Invalid Directory or Filename!');
  284.        exit;
  285.      end;
  286.      gotoxy (1,17);
  287.      textcolor (11);
  288.      textbackground (0);
  289.      write ('Copying ');
  290.      textcolor (15);
  291.      write (cf);
  292.      textcolor (11);
  293.      write (' to ');
  294.      textcolor (15);
  295.      write (ct);
  296.      textcolor (11);
  297.      write ('.');
  298.      exec(getenv('COMSPEC'),'/C copy '+cf+' '+ct);
  299.      gotoxy (1,8);
  300.      for a:=8 to 18 do begin
  301.       gotoxy (1,a);
  302.       clreol;
  303.      end;
  304.      cursor (3);
  305.      delay (1000);
  306. end;
  307.  
  308. procedure moveproc;
  309. var mf,mt:string;
  310. begin
  311.      gotoxy (1,8);
  312.      textcolor (14);
  313.      textbackground (1);
  314.      writeln ('╔══ Move ═══════════════════════════════════════════╗');
  315.      writeln ('║                                                   ║');
  316.      writeln ('╚═══════════════════════════════════════════════════╝');
  317.      cursor (2);
  318.      gotoxy (3,9);
  319.      textcolor (15);
  320.      readln (mf);
  321.      if length(mf)=0 then begin
  322.        writeln ('Invalid Filename!');
  323.        exit;
  324.      end;
  325.      gotoxy (1,12);
  326.      textcolor (14);
  327.      writeln ('╔══ To ═════════════════════════════════════════════╗');
  328.      writeln ('║                                                   ║');
  329.      writeln ('╚═══════════════════════════════════════════════════╝');
  330.      gotoxy (3,13);
  331.      textcolor (15);
  332.      readln (mt);
  333.      if length(mt)=0 then begin
  334.        writeln ('Invalid Directory or Filename!');
  335.        exit;
  336.      end;
  337.      gotoxy (1,16);
  338.      textcolor (11);
  339.      write ('Moving ');
  340.      textcolor (15);
  341.      write (mf);
  342.      textcolor (11);
  343.      write ('to ');
  344.      textcolor (15);
  345.      write (mt);
  346.      textcolor (11);
  347.      write ('.   ');
  348.      exec(getenv('COMSPEC'),'/C MOVE '+MF+' '+MT);
  349.      if doserror <> 0 then writeln ('MOVE.COM not found!');
  350.      textbackground (0);
  351.      for a:=8 to 25 do begin
  352.       gotoxy (1,a);
  353.       clreol;
  354.      end;
  355.      cursor (3);
  356.      delay (1000);
  357. end;
  358.  
  359. procedure execcmds;
  360. begin
  361.      gotoxy (26,2);
  362.      textbackground (15);
  363.      textcolor (4);
  364.      writeln ('╔════════╗');
  365.      gotoxy (26,3);
  366.      writeln ('║ Copy   ║');
  367.      gotoxy (26,4);
  368.      writeln ('║ Move   ║');
  369.      gotoxy (26,5);
  370.      writeln ('║ Rename ║');
  371.      gotoxy (26,6);
  372.      writeln ('║ Other..║');
  373.      gotoxy (26,7);
  374.      writeln ('╚════════╝');
  375.      textbackground (15);
  376.      textcolor (4);
  377.      bhigh (z);
  378.      repeat
  379.        c:=readkey;
  380.        c:=upcase(c);
  381.      until c in [#77,#75,#72,#80,#27,#13,#3];
  382.      if (c=#77) or (c=#80) then z:=z+1;
  383.      if (c=#75) or (c=#72) then z:=z-1;
  384.      if z=0 then z:=4;
  385.      if z=5 then z:=1;
  386.      if c=#27 then exit;
  387.      if c=#3 then halt(0);
  388.      if c=#13 then begin
  389.       case z of
  390.         1:copyproc;
  391.         2:moveproc;
  392.       {  3:renameproc;
  393.         4:otherdosproc;   }
  394.        end;
  395.      end;
  396.     execcmds
  397. end;
  398.  
  399. procedure firstbar;
  400. begin
  401.      textbackground(0);
  402.      clrscr;
  403.      textbackground (15);
  404.      textcolor (4);
  405.      writeln ('Name    pasword   RmDir   ExecCmd   Delete   Dir   Help   Quit                  ');
  406.      high (x);
  407.      repeat
  408.        c:=readkey;
  409.        c:=upcase(c);
  410.      until c in [#77,#75,#13,#3];
  411.      if c=#77 then x:=x+1;
  412.      if c=#75 then x:=x-1;
  413.      if x=9 then x:=1;
  414.      if x=0 then x:=8;
  415.      if c=#3 then halt(0);
  416.      if c=#13 then begin
  417.       case x of
  418.        1:changedir;
  419.        2:makedir;
  420.        3:;
  421.        4:execcmds;
  422.        5:;
  423.        6:;
  424.        7:dohelp;
  425.        8:halt(0);
  426.       end;
  427.      end;
  428.      firstbar
  429.  
  430. end;
  431.  
  432.  
  433. begin
  434.      clrscr;
  435.      cursor (3);
  436.      x:=1;
  437.      y:=1;
  438.      z:=1;
  439.      firstbar;
  440. end.
  441.